home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 015 / headers.arc / HEADERS.MB < prev   
Encoding:
Text File  |  1986-04-28  |  22.8 KB  |  893 lines
  1. ' Program HEADERS - Version 4.01
  2. '
  3. ' DATE: April 28, 1986
  4. ' TIME: 7:45 a.m.
  5. '
  6. ' Placed in the Public Domain by software, etc.
  7. '
  8. ' Documentation..........HEADERS.DOC
  9. ' Modular BASIC source...HEADERS.MB
  10. ' Translation table......HEADERS.TBL
  11. ' BASIC source...........HEADERS.BAS
  12. ' Executeable program....HEADERS.EXE
  13. '
  14. ' Environment:
  15. '    Must be compatible with hardware/software below.     To obtain
  16. '    99, 108, 132 or 165 lines/page, a Graphics Printer is required.
  17. '
  18. '    Hardware: IBM PC/XT/AT with 80 CPS Matrix or Graphics Printer
  19. '    Software: IBM PC-DOS 2.10, 3.00, 3.10, or 3.20
  20. '
  21. ' Please send comments or questions to:
  22. '
  23. '    software, etc.
  24. '    P.O. Box 25469
  25. '    Rochester, NY 14625
  26.  
  27. DEFINT A-Z
  28. ON ERROR GOTO ErrorHandler@
  29.  
  30.  
  31. DEF fnNumberField(s$,Description$)
  32.   LocEqualSign = INSTR(s$,"=")
  33.   If LocEqualSign < 2 OR LocEqualSign = LEN(s$)
  34.     PRINT "Invalid ";Description$;" - ";s$
  35.     SYSTEM
  36.   EndIf
  37.   n$ = RIGHT$(s$,LEN(s$)-LocEqualSign)
  38.   If 1 <= FIX(VAL(n$)) AND FIX(VAL(n$)) <= 32767
  39.     fnNumberField = FIX(VAL(n$))
  40.   ElseIf n$ = "0"
  41.     fnNumberField = 0
  42.   Else
  43.     PRINT "Invalid number for ";Description$;" - ";FIX(VAL(n$))
  44.     SYSTEM
  45.   EndIf
  46. END DEF
  47.  
  48. DEF fnValidPage = (BeginningPage <= CurrentPage AND CurrentPage <= EndingPage)
  49.  
  50. DEF fnNumber$(x) = MID$(STR$(x),2,LEN(STR$(x))-1)
  51.  
  52.  
  53. InitializeProgram
  54. InitializePrinter
  55. PrintFile
  56. RestorePrinter
  57.  
  58. SYSTEM
  59.  
  60.  
  61.  
  62. Procedure InitializeProgram
  63.   FALSE = 0: TRUE = NOT FALSE
  64.   InputChannel  = 1
  65.   OutputChannel = 2
  66.   BreakDetected = FALSE
  67.  
  68.   CtrlC$ = CHR$( 3)
  69.   ht$    = CHR$( 9)
  70.   lf$    = CHR$(10)
  71.   ff$    = CHR$(12)
  72.   cr$    = CHR$(13)
  73.   esc$   = CHR$(27)
  74.   sp$    = " "
  75.  
  76.   KEY OFF
  77.   WIDTH 80
  78.   COLOR 7,0
  79.   CLS
  80.  
  81.   cmd$ = COMMAND$
  82.   If LEN(cmd$) = 0
  83.     GiveInstructions
  84.     SYSTEM
  85.   EndIf
  86.   PRINT "Version 4.01 HEADERS ";cmd$
  87.   PRINT
  88.   GetHeaderData
  89.   GetFileNameAndOpt
  90.   OpenInputFile
  91.   ParseOpt
  92. EndProcedure
  93.  
  94.  
  95.  
  96. Procedure GiveInstructions
  97.   CLS
  98.   PRINT "           HEADERS Version 4.01 - Command Summary"
  99.   PRINT "SET HEADER1=Something for left part of header   (optional)"
  100.   PRINT "SET HEADER2=Something for center part of header (optional)"
  101.   PRINT "HEADERS FileName/W=www,L=lll,R=rrr,H=hhh,G=ggg,D,S=sss,B=bbb,E=eee"
  102.   PRINT "                 |     |     |     |     |     | |     |     |"
  103.   PRINT "Width____________|     |     |     |     |     | |     |     |"
  104.   PRINT "Left margin size_______|     |     |     |     | |     |     |"
  105.   PRINT "Right margin size____________|     |     |     | |     |     |"
  106.   PRINT "Height (lines/page)________________|     |     | |     |     |"
  107.   PRINT "Gap between pages (blank lines)__________|     | |     |     |"
  108.   PRINT "Double Strike__________________________________| |     |     |"
  109.   PRINT "Spacing (e.g, S=2 means double-space)____________|     |     |"
  110.   PRINT "Beginning page_________________________________________|     |"
  111.   PRINT "Ending page__________________________________________________|"
  112.   PRINT
  113.   PRINT "DEFAULTS:  W=80  L=0  R=0  H=66  G=6  S=1  B=1  E=32767"
  114.   PRINT "           Double-strike used only for H=99, 108, 132, or 165."
  115.   PRINT "           Otherwise, use option D to obtain double-strike."
  116.   PRINT "W must be set to 40, 66, 80, or 132"
  117.   PRINT "H must be set to 11, 22, 33, 44, 66, 88, 99, 108, 132, or 165."
  118.   PRINT "           Graphics Printer required for 99, 108, 132, or 165."
  119.   PRINT "Continuation lines not used unless L > 0"
  120. EndProcedure
  121.  
  122.  
  123.  
  124. Procedure GetHeaderData
  125.   LeftSide$ = ENVIRON$("HEADER1")
  126.   Middle$   = ENVIRON$("HEADER2")
  127.   HeaderNeeded = (LEN(LeftSide$) + LEN(Middle$) > 0)
  128.   If HeaderNeeded
  129.     t$ = LeftSide$
  130.     CALL Capitalize(t$)
  131.     If     t$ = "DATE"
  132.       LeftSide$ = DATE$
  133.     ElseIf t$ = "TIME"
  134.       LeftSide$ = TIME$
  135.     ElseIf t$ = "DATE,TIME"
  136.       LeftSide$ = DATE$ + " at " + TIME$
  137.     ElseIf t$ = "TIME,DATE"
  138.       LeftSide$ = TIME$ + "  " + DATE$
  139.     EndIf
  140.   EndIf
  141. EndProcedure
  142.  
  143.  
  144.  
  145. Procedure GetFileNameAndOpt
  146. '
  147. ' HEADERS FileName/Opt
  148. '
  149.   LocSlash = INSTR(cmd$,"/")
  150.   If LocSlash = 0
  151.     FileName$ = cmd$
  152.     Opt$      = ""
  153.   Else
  154.     FileName$ = LEFT$(cmd$,LocSlash-1)
  155.     Opt$      = RIGHT$(cmd$,LEN(cmd$)-LocSlash)
  156.   EndIf
  157. EndProcedure
  158.  
  159.  
  160.  
  161. Procedure OpenInputFile
  162.   If LEN(FileName$) = 0
  163.     GiveInstructions
  164.     SYSTEM
  165.   EndIf
  166.   HeaderName$=FileName$
  167.   If MID$(HeaderName$,2,1)=":"  'Remove drive spec for use in header
  168.     HeaderName$=MID$(HeaderName$,3,len(HeaderName$)-2)
  169.   EndIf
  170.   ON ERROR GOTO FileNotFound@
  171.   OPEN "Input",#InputChannel,FileName$
  172.   ON ERROR GOTO ErrorHandler@
  173. EndProcedure
  174.  
  175.  
  176.  
  177. FileNotFound@
  178.   PRINT: PRINT "Sorry, but your file cannot be opened."
  179.   CALL BASICErr(ErrorMsg$)
  180.   PRINT ErrorMsg$
  181.   SYSTEM
  182.  
  183.  
  184.  
  185. Procedure ParseOpt
  186. '
  187. ' Set up default options
  188. '
  189.   CharactersPerLine = 80
  190.   MarginSize        = 0
  191.   RightMarginSize   = 0
  192.  
  193.   LinesPerPage      = 66
  194.   InterPageGap      = 6
  195.   BlankLineCount    = 0
  196.  
  197.   BeginningPage     = 1
  198.   EndingPage        = 32767
  199.  
  200.   WidthSpecified         = FALSE
  201.   MarginSpecified        = FALSE
  202.   RightMarginSpecified   = FALSE
  203.   HeightSpecified        = FALSE
  204.   GapSpecified           = FALSE
  205.   DoubleStrikeSpecified  = FALSE
  206.   SpacingSpecified       = FALSE
  207.   BeginningPageSpecified = FALSE
  208.   EndingPageSpecified    = FALSE
  209.  
  210.   CALL Replace(Opt$,",",sp$)       'Replace commas with spaces
  211.   CALL Replace(Opt$,ht$,sp$)       'Replace tabs with spaces
  212.   CALL Replace(Opt$,sp$+sp$,sp$)   'Replace multiple spaces with space
  213.   Loop
  214.     If LEN(Opt$) = 0
  215.       ExitLoop
  216.     Else
  217.       LocSpace = INSTR(Opt$,sp$)
  218.       If LocSpace = 0
  219.         CurrentOpt$ = Opt$
  220.         Opt$        = ""
  221.       Else
  222.         CurrentOpt$ = LEFT$(Opt$,LocSpace-1)
  223.         Opt$        = RIGHT$(Opt$,LEN(Opt$)-LocSpace)
  224.       EndIf
  225.  
  226.       IF     LEFT$(CurrentOpt$,2) = "W="
  227.         If WidthSpecified
  228.           CALL RedefinedError("Characters per line")
  229.         Else
  230.           WidthSpecified    = TRUE
  231.           CharactersPerLine = fnNumberField(CurrentOpt$,"Characters per line")
  232.         EndIf
  233.  
  234.       ElseIf LEFT$(CurrentOpt$,2) = "L="
  235.         If MarginSpecified
  236.           CALL RedefinedError("Left margin")
  237.         Else
  238.           MarginSpecified = TRUE
  239.           MarginSize      = fnNumberField(CurrentOpt$,"Left margin")
  240.         EndIf
  241.  
  242.       ElseIf LEFT$(CurrentOpt$,2) = "R="
  243.         If RightMarginSpecified
  244.           CALL RedefinedError("Right margin")
  245.         Else
  246.           RightMarginSpecified = TRUE
  247.           RightMarginSize      = fnNumberField(CurrentOpt$,"Right margin")
  248.         EndIf
  249.  
  250.       ElseIf LEFT$(CurrentOpt$,2) = "H="
  251.         If HeightSpecified
  252.           CALL RedefinedError("Lines per page")
  253.         Else
  254.           HeightSpecified = TRUE
  255.           LinesPerPage   = fnNumberField(CurrentOpt$,"Lines per page")
  256.         EndIf
  257.  
  258.       ElseIf LEFT$(CurrentOpt$,2) = "G="
  259.         If GapSpecified
  260.           CALL RedefinedError("Interpage gap")
  261.         Else
  262.           GapSpecified = TRUE
  263.           InterpageGap = fnNumberField(CurrentOpt$,"Interpage gap")
  264.         EndIf
  265.  
  266.       ElseIf LEFT$(CurrentOpt$,2) = "S="
  267.         If SpacingSpecified
  268.           CALL RedefinedError("Spacing")
  269.         Else
  270.           SpacingSpecified = TRUE
  271.           BlankLineCount = fnNumberField(CurrentOpt$,"Spacing")-1
  272.         EndIf
  273.  
  274.       ElseIf LEFT$(CurrentOpt$,2) = "B="
  275.         If BeginningPageSpecified
  276.           CALL RedefinedError("Beginning page")
  277.         Else
  278.           BeginningPageSpecified = TRUE
  279.           BeginningPage = fnNumberField(CurrentOpt$,"Beginning page")
  280.         EndIf
  281.  
  282.       ElseIf LEFT$(CurrentOpt$,2) = "E="
  283.         If EndingPageSpecified
  284.           CALL RedefinedError("Ending page")
  285.         Else
  286.           EndingPageSpecified = TRUE
  287.           EndingPage = fnNumberField(CurrentOpt$,"Ending page")
  288.         EndIf
  289.  
  290.       ElseIf CurrentOpt$ = "D"
  291.         If DoubleStrikeSpecified
  292.           CALL RedefinedError("Double strike")
  293.         Else
  294.           DoubleStrikeSpecified = TRUE
  295.         EndIf
  296.  
  297.       Else
  298.         PRINT "Unrecognized option - ";CurrentOpt$
  299.         SYSTEM
  300.       EndIf
  301.     EndIf
  302.   EndLoop
  303.  
  304.   If BeginningPage > EndingPage
  305.     PRINT "Beginning page =";STR$(BeginningPage)
  306.     PRINT "Ending page    =";STR$(EndingPage)
  307.     PRINT "Nothing to print."
  308.     RestorePrinter
  309.     SYSTEM
  310.   EndIf
  311. EndProcedure
  312.  
  313.  
  314.  
  315. SUB Replace(s$,Old$,New$) STATIC
  316.   STATIC LengthOld,LocOld,l$,r$
  317.   LengthOld = LEN(Old$)
  318.   If LengthOld = 0
  319.     EXIT SUB
  320.   EndIf
  321.   Loop
  322.     ExitLoop IF LEN(s$) = 0
  323.     LocOld = INSTR(s$,Old$)
  324.     ExitLoop IF LocOld = 0
  325.     l$ = LEFT$(s$,LocOld-1)
  326.     r$ = RIGHT$(s$,LEN(s$)-(LocOld+LengthOld-1))
  327.     s$ = l$ + New$ + r$
  328.   EndLoop
  329. END SUB
  330.  
  331.  
  332.  
  333. SUB RedefinedError(s$) STATIC
  334.   PRINT "Option defined more than once - ";s$
  335.   SYSTEM
  336. END SUB
  337.  
  338.  
  339.  
  340. Procedure PrintFile
  341.   PRINT "Lines per page....";STR$(LinesPerPage)
  342.   PRINT "Interpage gap.....";STR$(InterpageGap)
  343.   PRINT "Line width........";STR$(CharactersPerLine)
  344.   IF MarginSize > 0      THEN PRINT "Left margin.......";STR$(MarginSize)
  345.   IF RightMarginSize > 0 THEN PRINT "Right margin......";STR$(RightMarginSize)
  346.   IF BeginningPage > 1   THEN PRINT "Beginning page...";STR$(BeginningPage)
  347.   IF EndingPage < 32767  THEN PRINT "Ending page......";STR$(EndingPage)
  348.   IF LEN(LeftSide$) > 0 THEN PRINT "HEADER1: ";LeftSide$
  349.   IF LEN(Middle$) > 0 THEN PRINT "HEADER2: ";Middle$
  350.   IF NOT HeaderNeeded THEN PRINT "Header lines not used"
  351.   If BlankLineCount <= 0
  352.     PRINT "Single spacing"
  353.   ElseIf BlankLineCount = 1
  354.     PRINT "Double spacing"
  355.   ElseIf BlankLineCount = 2
  356.     PRINT "Triple spacing"
  357.   Else
  358.     PRINT "Inserting";STR$(BlankLineCount);
  359.     PRINT " blank lines after each line of text"
  360.   EndIf
  361.   IF DoubleStrikeSpecified THEN PRINT "Double strike active"
  362.  
  363.   CurrentPage = 0
  364.   PrintHeader
  365.   WHILE (CurrentPage <= EndingPage) AND NOT EOF(InputChannel)
  366.     CheckForBreak
  367.     If BreakDetected
  368.       BreakDetected = FALSE
  369.       HandleBreak
  370.     EndIf
  371.     ReadLine
  372.     PrintLine
  373.   WEND
  374.   CLOSE InputChannel
  375.  
  376.   EjectPage
  377. EndProcedure
  378.  
  379.  
  380.  
  381. Procedure CheckForBreak
  382.   Repeat
  383.     t$ = INKEY$
  384.     IF t$ = CtrlC$ THEN BreakDetected = TRUE
  385.   Until LEN(t$) = 0
  386. EndProcedure
  387.  
  388.  
  389.  
  390. Procedure HandleBreak
  391.   ReturnMsg$ = " Return to DOS? (y/n) "
  392.   PRINT: COLOR 0,7: PRINT ReturnMsg$;: COLOR 7,0: LOCATE ,,1
  393.   Repeat
  394.     Repeat
  395.       t$ = INKEY$
  396.     Until LEN(t$) = 1
  397.     CALL Capitalize(t$)
  398.   Until t$ = "Y" OR t$ = "N"
  399.   If t$ = "Y"
  400.     PRINT
  401.     EjectPage
  402.     RestorePrinter
  403.     SYSTEM
  404.   Else
  405.     LOCATE ,1,0: PRINT SPACE$(LEN(ReturnMsg$));: LOCATE ,1,0
  406.   EndIf
  407. EndProcedure
  408.  
  409.  
  410.  
  411. Procedure PrintLeftMargin
  412.   IF MarginSize > 0 THEN PRINT# OutputChannel,SPACE$(MarginSize);
  413. EndProcedure
  414.  
  415.  
  416.  
  417. Procedure PrintOverflowMargin
  418.   If MarginSize > 2
  419.     PRINT# OutputChannel,SPACE$(MarginSize-2);"| ";
  420.   ElseIf MarginSize = 2
  421.     PRINT# OutputChannel,"| ";
  422.   ElseIf MarginSize = 1
  423.     PRINT# OutputChannel,"|";
  424.   EndIf
  425. EndProcedure
  426.  
  427.  
  428.  
  429. Procedure PrintHeader
  430.   CurrentPage=CurrentPage+1
  431.   LinesLeft = AvailableLines
  432.   If HeaderNeeded
  433.     If fnValidPage
  434.       PRINT# OutputChannel,CheckPaperEnd$;
  435.       BuildHeaderLine$
  436.       PrintLeftMargin
  437.       PRINT# OutputChannel,HeaderLine$;NewLine$;
  438.       PrintLeftMargin
  439.       PRINT# OutputChannel,STRING$(AvailableSpace,"-");NewLine$;
  440.       PRINT# OutputChannel,IgnorePaperEnd$;
  441.     EndIf
  442.     LinesLeft=LinesLeft-2
  443.   EndIf
  444. EndProcedure
  445.  
  446.  
  447.  
  448. Procedure BuildHeaderLine$
  449.   Page$ = "-" + fnNumber$(CurrentPage) + "-"
  450.   RightSide$ = HeaderName$ + sp$ + Page$
  451.   Room = AvailableSpace - (LEN(LeftSide$) + LEN(Middle$) + LEN(RightSide$))
  452.   If Room >= 2 'Need at least one space on each side of Middle$
  453.     Gap1$ = SPACE$(Room \ 2)
  454.     Gap2$ = SPACE$(Room - LEN(Gap1$))
  455.     HeaderLine$ = LeftSide$ + Gap1$ + Middle$ + Gap2$ + RightSide$
  456.     ExitProcedure
  457.   EndIf
  458.  
  459.   Room = AvailableSpace - (LEN(LeftSide$) + LEN(RightSide$))
  460.   If Room >= 1 'Need at least one space between LeftSide$ and RightSide$
  461.     HeaderLine$ = LeftSide$ + SPACE$(Room) + RightSide$
  462.     ExitProcedure
  463.   EndIf
  464.  
  465.   Room = AvailableSpace - (LEN(Middle$) + LEN(RightSide$))
  466.   If Room >= 1 'Need at least one space between Middle$ and RightSide$
  467.     HeaderLine$ = Middle$ + SPACE$(Room) + RightSide$
  468.     ExitProcedure
  469.   EndIf
  470.  
  471.   Room = AvailableSpace - LEN(RightSide$)
  472.   If Room = 0
  473.     HeaderLine$ = RightSide$
  474.     ExitProcedure
  475.   ElseIf Room > 0
  476.     HeaderLine$ = SPACE$(Room) + RightSide$
  477.     ExitProcedure
  478.   EndIf
  479.  
  480.   Room = AvailableSpace - LEN(Page$)
  481.   If Room = 0
  482.     HeaderLine$ = Page$
  483.     ExitProcedure
  484.   ElseIf Room > 0
  485.     HeaderLine$ = SPACE$(Room) + Page$
  486.     ExitProcedure
  487.   EndIf
  488.  
  489. 'No room for even the page number!
  490. 'Risk abort if AvailableSpace = 0.  Nothing else would work anyway.
  491.  
  492.   HeaderLine$ = STRING$(AvailableSpace,"?")
  493. EndProcedure
  494.  
  495.  
  496.  
  497. Procedure ReadLine
  498.   LINE INPUT# InputChannel,Text$
  499.   CALL Replace(Text$,lf$+cr$,sp$) 'Replace linefeed/return with space
  500.   CALL Replace(Text$,lf$,sp$)     'Replace isolated linefeed with space
  501.   CALL Replace(Text$,ff$,"")      'Eliminate formfeeds
  502.   HandleTabs                      'Replace horizontal tabs with spaces
  503.   RemoveTrailingWhiteSpace
  504. EndProcedure
  505.  
  506.  
  507.  
  508. Procedure HandleTabs
  509.   ExitProcedure IF LEN(Text$) = 0
  510.   Loop
  511.     TabSpot = INSTR(Text$,ht$)
  512.     ExitLoop IF TabSpot = 0
  513.     L$ = LEFT$(Text$,TabSpot-1) + sp$
  514.     R$ = RIGHT$(Text$,LEN(Text$)-TabSpot)
  515.     WHILE 0 <> (LEN(L$) MOD 8): L$ = L$ + sp$: WEND
  516.     Text$ = L$ + R$
  517.   EndLoop
  518. EndProcedure
  519.  
  520.  
  521.  
  522. Procedure RemoveTrailingWhiteSpace
  523.   WHILE RIGHT$(Text$,1) = sp$
  524.     Text$ = LEFT$(Text$,LEN(Text$)-1)
  525.   WEND
  526. EndProcedure
  527.  
  528.  
  529.  
  530. Procedure PrintLine
  531.   If Text$=""
  532.     MakePrintLine
  533.     LinesLeft=LinesLeft-1
  534.     If fnValidPage
  535.       PRINT# OutputChannel,NewLine$;
  536.       PrintBlankLines
  537.     EndIf
  538.   ElseIf LEN(Text$) <= AvailableSpace
  539.     MakePrintLine
  540.     LinesLeft=LinesLeft-1
  541.     If fnValidPage
  542.       PrintLeftMargin
  543.       PRINT# OutputChannel,Text$;NewLine$;
  544.       PrintBlankLines
  545.     EndIf
  546.   ELSE
  547.     MakePrintLine
  548.     t$=MID$(Text$,1,AvailableSpace)
  549.     Text$=MID$(Text$,AvailableSpace+1,LEN(Text$)-AvailableSpace)
  550.     If fnValidPage
  551.       PrintLeftMargin
  552.       PRINT# OutputChannel,t$;NewLine$;
  553.       PrintBlankLines
  554.     EndIf
  555.     ExitProcedure IF MarginSize = 0
  556.     LinesLeft=LinesLeft-1
  557.     WHILE LEN(Text$) >AvailableSpace
  558.       MakePrintLine
  559.       t$=MID$(Text$,1,AvailableSpace)
  560.       Text$=MID$(Text$,AvailableSpace+1,LEN(Text$)-AvailableSpace)
  561.       If fnValidPage
  562.         PrintOverflowMargin
  563.         PRINT# OutputChannel,t$;NewLine$;
  564.         PrintBlankLines
  565.       EndIf
  566.       LinesLeft=LinesLeft-1
  567.     WEND
  568.     If Text$<>""
  569.       MakePrintLine
  570.       If fnValidPage
  571.         PrintOverflowMargin
  572.         PRINT# OutputChannel,Text$;NewLine$;
  573.         PrintBlankLines
  574.       EndIf
  575.       LinesLeft=LinesLeft-1
  576.     EndIf
  577.   EndIf
  578. EndProcedure
  579.  
  580.  
  581.  
  582. Procedure MakePrintLine
  583.   ExitProcedure IF LinesLeft > 0
  584.   EjectPage
  585.   PrintHeader
  586. EndProcedure
  587.  
  588.  
  589.  
  590. Procedure EjectPage
  591.   IF fnValidPage THEN PRINT# OutputChannel,NewPage$;
  592. EndProcedure
  593.  
  594.  
  595.  
  596. Procedure PrintBlankLines
  597.   ExitProcedure IF BlankLineCount = 0
  598.   FOR i = 1 TO BlankLineCount
  599.     MakePrintLine
  600.     If fnValidPage
  601.       PRINT# OutputChannel,NewLine$;
  602.     EndIf
  603.     LinesLeft = LinesLeft - 1
  604.   NEXT
  605. EndProcedure
  606.  
  607.  
  608.  
  609. Procedure InitializePrinter
  610.   ON ERROR GOTO PrinterNotFound@
  611.   OPEN "OUTPUT",#OutputChannel,"LPT1:"
  612.   ON ERROR GOTO ErrorHandler@
  613.   WIDTH #OutputChannel,255 'Suppress automatic line folding on printer.
  614.   CheckPaperEnd$  = esc$ + "9"
  615.   IgnorePaperEnd$ = esc$ + "8"
  616.   Wide$           = CHR$(14)
  617.   Compressed$     = CHR$(15)
  618.   DoubleStrike$   = esc$ + "G"
  619.   Superscript$    = esc$ + "S" + CHR$(1)
  620.   NewLine$        = cr$
  621.   NewPage$        = ff$
  622.  
  623.   RestorePrinter
  624.  
  625.   Mode$ = ""
  626.   If     LinesPerPage = 99
  627.     Mode$ = SuperScript$ + Compressed$
  628.   ElseIf LinesPerPage = 108
  629.     Mode$ = SuperScript$ + Compressed$
  630.   ElseIf LinesPerPage = 132
  631.     Mode$ = SuperScript$ + Compressed$
  632.   ElseIf LinesPerPage = 165
  633.     Mode$ = SuperScript$ + Compressed$
  634.   ElseIf CharactersPerLine = 40
  635.     Mode$ = Wide$
  636.     NewLine$ = NewLine$ + Wide$
  637.     NewPage$ = NewPage$ + Wide$
  638.   ElseIf CharactersPerLine = 66
  639.     Mode$ = Wide$+Compressed$
  640.     NewLine$ = NewLine$ + Wide$
  641.     NewPage$ = NewPage$ + Wide$
  642.   ElseIf CharactersPerLine = 80
  643.     Mode$ = ""
  644.   ElseIf CharactersPerLine = 132
  645.     Mode$ = Compressed$
  646.   Else
  647.     PRINT STR$(CharactersPerLine);" characters per line not supported."
  648.     PRINT " Support available for 40, 66, 80, and 132 characters per line."
  649.     SYSTEM
  650.   EndIf
  651.   SetMode
  652.  
  653.   If     LinesPerPage = 11
  654.     CALL SetLinesPerInch(1)
  655.   ElseIf LinesPerPage = 22
  656.     CALL SetLinesPerInch(2)
  657.   ElseIf LinesPerPage = 33
  658.     CALL SetLinesPerInch(3)
  659.   ElseIf LinesPerPage = 44
  660.     CALL SetLinesPerInch(4)
  661.   ElseIf LinesPerPage = 66
  662.     CALL SetLinesPerInch(6)
  663.   ElseIf LinesPerPage = 88
  664.     CALL SetLinesPerInch(8)
  665.   ElseIf LinesPerPage = 99
  666.     Mode$ = Mode$ + esc$+"3"+CHR$(24)
  667.   ElseIf LinesPerPage = 108
  668.     Mode$ = Mode$ + esc$+"3"+CHR$(22)
  669.   ElseIf LinesPerPage = 132
  670.     Mode$ = Mode$ + esc$+"3"+CHR$(18)
  671.   ElseIf LinesPerPage = 165
  672.     Mode$ = Mode$ + esc$+"3"+CHR$(14)
  673.   Else
  674.     PRINT STR$(LinesPerPage);" lines per page is not supported."
  675.     PRINT " Values supported: 11, 22, 33, 44, 66, 88, 99, 108, 132, and 165."
  676.     PRINT " The Graphics Printer is required for 99, 108, 132, and 165."
  677.     SYSTEM
  678.   EndIf
  679.   IF NOT GapSpecified THEN InterpageGap = LinesPerPage\11
  680.   PRINT# OutputChannel,Mode$;
  681.  
  682.   AvailableSpace = CharactersPerLine - (MarginSize + RightMarginSize)
  683.   If AvailableSpace <= 0
  684.     PRINT "Characters per line =";STR$(CharactersPerLine);
  685.     PRINT "Left margin size    =";STR$(MarginSize)
  686.     PRINT "Right margin size   =";STR$(RightMarginSize)
  687.     PRINT "No columns available for text."
  688.     SYSTEM
  689.   EndIf
  690.  
  691.   If InterpageGap > 0
  692.     AvailableLines = LinesPerPage - InterPageGap
  693.     If AvailableLines <= 0
  694.       PRINT "Lines per page =";STR$(LinesPerPage)
  695.       PRINT "Interpage gap  =";STR$(InterPageGap)
  696.       PRINT "No lines available for text."
  697.       SYSTEM
  698.     EndIf
  699.   Else
  700.     AvailableLines = 32767
  701.   EndIf
  702. EndProcedure
  703.  
  704.  
  705.  
  706. PrinterNotFound@
  707.   PRINT: PRINT "Printer LPT1: cannot be opened."
  708.   SYSTEM
  709.  
  710.  
  711.  
  712. Procedure SetMode
  713.   If LinesPerPage <= 88
  714.     IF DoubleStrikeSpecified THEN Mode$ = Mode$ + DoubleStrike$
  715.   EndIf
  716. EndProcedure
  717.  
  718.  
  719.  
  720. SUB SetLinesPerInch(n) STATIC
  721.   SHARED esc$,Mode$
  722.   Mode$ = Mode$+esc$+"A"+CHR$(72\n)+esc$+"2"
  723. END SUB
  724.  
  725.  
  726.  
  727. Procedure RestorePrinter
  728.   PRINT# OutputChannel,esc$;"T";
  729.   PRINT# OutputChannel,esc$;"F";
  730.   PRINT# OutputChannel,esc$;"H";
  731.   PRINT# OutputChannel,CHR$(18);
  732.   PRINT# OutputChannel,CHR$(20);
  733.   PRINT# OutputChannel,esc$;"A";CHR$(12);esc$;"2";
  734.   PRINT# OutputChannel,CheckPaperEnd$;
  735. EndProcedure
  736.  
  737.  
  738.  
  739. SUB Capitalize(s$) STATIC
  740.   STATIC i,Length
  741.   Length = LEN(s$)
  742.   If LEN(s$) > 0
  743.     FOR i = 1 TO Length
  744.       ch$=MID$(s$,i,1)
  745.       IF "a" <=ch$ AND ch$ <= "z" THEN MID$(s$,i,1)=chr$(asc(ch$)-32)
  746.     NEXT
  747.   EndIf
  748. END SUB
  749.  
  750.  
  751.  
  752. ErrorHandler@
  753.   BEEP
  754.   PRINT
  755.   If ERR = 24 OR ERR = 25 OR ERR = 27
  756.  
  757.     Repeat
  758.       SecondsSinceMidnight! = TIMER
  759.     Until SecondsSinceMidnight! < 86300!  'Avoid clock roll-over
  760.     TimeToAbort! = SecondsSinceMidnight! + 60
  761.  
  762.     PRINT "Printer is off or out of paper."
  763.     PRINT "Please do not turn off the power if it is already on."
  764.     PRINT "Currently on page";STR$(CurrentPage)
  765.     If NOT OperatorIsPresent
  766.       PRINT "Starting 60-second time-out before terminating."
  767.       PRINT "If you elect to continue, you will be given as"
  768.       PRINT "much time as necessary to prepare the printer."
  769.       PRINT
  770.     EndIf
  771.     COLOR 0,7: PRINT " C)ontinue or Q)uit? ";: COLOR 7,0
  772.     LOCATE ,,1
  773.     Repeat
  774.       Repeat
  775.         If TIMER > TimeToAbort! AND NOT OperatorIsPresent
  776.           LOCATE ,1,0: PRINT "                      ";: LOCATE ,1,0
  777.           COLOR 0,7: PRINT " 60-second time out. ";: COLOR 7,0
  778.           PRINT
  779.           SomeString$ = "Q"
  780.         Else
  781.           SomeString$ = INKEY$
  782.         EndIf
  783.       Until LEN(SomeString$) <> 0
  784.       CALL Capitalize(SomeString$)
  785.     Until INSTR("CQ",SomeString$) > 0
  786.     If SomeString$ = "C"
  787.       OperatorIsPresent = TRUE
  788.       EnterMsg$ = " Press ENTER when ready... "
  789.       LOCATE ,1,0: COLOR 0,7: PRINT EnterMsg$;: COLOR 7,0: LOCATE ,,1
  790.       Repeat
  791.       Until INKEY$ = cr$
  792.       LOCATE ,1,0: PRINT SPACE$(LEN(EnterMsg$));: LOCATE ,1,0
  793.       PRINT# OutputChannel,Mode$;
  794.       RESUME
  795.     Else
  796.       PRINT "Q"
  797.       PRINT "If the printer is on, it may require resetting."
  798.       PRINT "To do so, turn it off, adjust top of form, and turn it back on."
  799.       SYSTEM
  800.     EndIf
  801.   EndIf
  802.  
  803.   RestorePrinter
  804.   CALL BASICERR(ErrorMsg$)
  805.   PRINT
  806.   PRINT "Error";STR$(ERR);" on line";STR$(ERL)
  807.   PRINT ErrorMsg$
  808.   SYSTEM
  809.  
  810.  
  811.  
  812. SUB BASICERR(ErrorMsg$) STATIC
  813.   If     ERR = 2
  814.     ErrorMsg$ = "Syntax error"
  815.   ElseIf ERR = 3
  816.     ErrorMsg$ = "RETURN without GOSUB"
  817.   ElseIf ERR = 4
  818.     ErrorMsg$ = "Out of DATA"
  819.   ElseIf ERR = 5
  820.     ErrorMsg$ = "Illegal function call"
  821.   ElseIf ERR = 6
  822.     ErrorMsg$ ="Overflow"
  823.   ElseIf ERR = 7
  824.     ErrorMsg$ = "Out of memory"
  825.   ElseIf ERR = 9
  826.     ErrorMsg$ = "Subscript out of range"
  827.   ElseIf ERR = 11
  828.     ErrorMsg$ = "Division by zero"
  829.   ElseIf ERR = 13
  830.     ErrorMsg$ = "Type mismatch"
  831.   ElseIf ERR = 14
  832.     ErrorMsg$ = "Out of string space"
  833.   ElseIf ERR = 16
  834.     ErrorMsg$ = "String formula too complex"
  835.   ElseIf ERR = 19
  836.     ErrorMsg$ = "No RESUME"
  837.   ElseIf ERR = 20
  838.     ErrorMsg$ = "RESUME without error"
  839.   ElseIf ERR = 24
  840.     ErrorMsg$ = "Device Timeout"
  841.   ElseIf ERR = 25
  842.     ErrorMsg$ = "Device Fault"
  843.   ElseIf ERR = 27
  844.     ErrorMsg$ = "Out of paper"
  845.   ElseIf ERR = 50
  846.     ErrorMsg$ = "FIELD overflow"
  847.   ElseIf ERR = 51
  848.     ErrorMsg$ = "Internal error"
  849.   ElseIf ERR = 52
  850.     ErrorMsg$ = "Bad file number"
  851.   ElseIf ERR = 53
  852.     ErrorMsg$ = "File not found"
  853.   ElseIf ERR = 54
  854.     ErrorMsg$ = "Bad file mode"
  855.   ElseIf ERR = 55
  856.     ErrorMsg$ = "File already open"
  857.   ElseIf ERR = 57
  858.     ErrorMsg$ = "Device I/O Error"
  859.   ElseIf ERR = 58
  860.     ErrorMsg$ = "File already exists"
  861.   ElseIf ERR = 61
  862.     ErrorMsg$ = "Disk full"
  863.   ElseIf ERR = 62
  864.     ErrorMsg$ = "Input past end"
  865.   ElseIf ERR = 63
  866.     ErrorMsg$ = "Bad record number"
  867.   ElseIf ERR = 64
  868.     ErrorMsg$ = "Bad file name"
  869.   ElseIf ERR = 67
  870.     ErrorMsg$ = "Too many files"
  871.   ElseIf ERR = 68
  872.     ErrorMsg$ = "Device unavailable"
  873.   ElseIf ERR = 69
  874.     ErrorMsg$ = "Communication buffer overflow"
  875.   ElseIf ERR = 70
  876.     ErrorMsg$ = "Permission Denied"
  877.   ElseIf ERR = 71
  878.     ErrorMsg$ = "Disk not Ready"
  879.   ElseIf ERR = 72
  880.     ErrorMsg$ = "Disk Media Error"
  881.   ElseIf ERR = 73
  882.     ErrorMsg$ = "Advanced Feature"
  883.   ElseIf ERR = 74
  884.     ErrorMsg$ = "Rename Across Disks"
  885.   ElseIf ERR = 75
  886.     ErrorMsg$ = "Path/file access error"
  887.   ElseIf ERR = 76
  888.     ErrorMsg$ = "Path not found"
  889.   Else
  890.     ErrorMsg$ = "Error"+STR$(ERR)+" (unclassified error)."
  891.   EndIf
  892. END SUB
  893.